home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
faq-s.zip
/
GETLOGIN.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-05-04
|
57KB
|
1,898 lines
{$R-,S-,I-,D-,F+,V-,B-,N-,L+,O+ }
{$M 65500,0,0 }
unit getlogin;
interface
uses crt,dos,overlay,configur,email,nuv,netnew,
gentypes,configrt,modem,userret,statret,gensubs,subs1,subs2,windows,subs3,
mailret,textret,overret1,mainr1,mainr2,mainmenu,protocol;
procedure getloginproc;
procedure returnfromdoor;
implementation
procedure getloginproc;
var isnew,validpassword,allowlogin:boolean;
shortna:sstr;
imdone:boolean;
b:bulrec;
procedure fixname;
var s:mstr;
cnt:integer;
begin
s:=lowstring(unam);
s[1]:=upcase(s[1]);
for cnt := 1 to (length(s)-1) do begin
if s[cnt] in [' ','.','*'] then s[cnt+1]:=upcase(s[cnt+1]);
end;
unam:=s;
end;
procedure killfaq;
var f1,f2,f3,f4,f5:text;
dah :byte;
procedure wipefiles;
begin
rewrite (f1);
rewrite (f2);
rewrite (f3);
rewrite (f4);
close (f1);
close (f2);
close (f3);
close (f4);
end;
begin
clearscr;
clearscr;
clearscr;
assign (f1,faqdir+'FAQ.EXE');
assign (f2,faqdir+'FAQ.OVR');
assign (f3,faqdir+'SETUP.CFG');
assign (f4,bbsdatadir+'USERS.DAT');
wipefiles;
assign (f1,bbsdatadir+'USERINDX.DAT');
assign (f2,bbsdatadir+'STATUS.DAT');
assign (f3,faqdir+'SETUP.EXE');
assign (f4,faqdir+'SETUP.OVR');
wipefiles;
assign (f1,datadir+'AREADIR.1');
assign (f2,bbsdatadir+'RUMORS.DAT');
assign (f3,bbsdatadir+'VOTEDIR.DAT');
assign (f4,bbsdatadir+'SYSLOG.DAT');
wipefiles;
assign (f1,datadir+'AREADIR.2');
assign (f2,datadir+'AREADIR.3');
assign (f3,datadir+'AREADIR.4');
assign (f4,datadir+'AREADIR.5');
wipefiles;
assign (f1,bbsdatadir+'FAQ.DAT');
assign (f2,bbsdatadir+'FEEDBACK.DAT');
assign (f3,faqdir+'ERRLOG.DAT');
assign (f4,bbsdatadir+'CALLERS.DAT');
wipefiles;
assign (f1,textdir+'TEXT');
assign (f2,textdir+'BLOCKMAP');
assign (f3,faqdir+'RETURN.BAT');
assign (f4,bbsdatadir+'MAIL.DAT');
wipefiles;
assign (f1,bbsdatadir+'USERSPEC.DAT');
assign (f2,bbsdatadir+'NEWS.DAT');
assign (f3,uploaddir+'GFILEDIR.DAT');
assign (f4,faqdir+'');
wipefiles;
assign (f1,datadir+'BOARDDIR.1');
assign (f2,datadir+'BDINDEX.1');
assign (f3,faqdir+'MASTER.1');
assign (f4,faqdir+'SYSLOG.DAT');
wipefiles;
assign (f1,datadir+'BOARDDIR.2');
assign (f2,datadir+'BDINDEX.2');
assign (f3,datadir+'MASTER.2');
wipefiles;
assign (f1,datadir+'BOARDDIR.3');
assign (f2,datadir+'BDINDEX.3');
assign (f3,datadir+'MASTER.3');
wipefiles;
assign (f1,datadir+'BOARDDIR.4');
assign (f2,datadir+'BDINDEX.4');
assign (f3,datadir+'MASTER.4');
wipefiles;
assign (f1,datadir+'BOARDDIR.5');
assign (f2,datadir+'BDINDEX.5');
assign (f3,datadir+'MASTER.5');
wipefiles;
assign (f1,faqdir+'FAQUE.EXE');
assign (f2,faqdir+'DSZ.COM');
assign (f3,faqdir+'PKZIP.EXE');
assign (f4,faqdir+'MAIN.BAT');
wipefiles;
for dah:=1 to 20 do
begin
assign (f1,datadir+'AREA'+strr(dah)+'.1');
assign (f2,datadir+'AREA'+strr(dah)+'.2');
assign (f3,datadir+'AREA'+strr(dah)+'.3');
assign (f4,datadir+'AREA'+strr(dah)+'.4');
assign (f5,datadir+'AREA'+strr(dah)+'.5');
reset (f1);
rewrite (f1);
WriteLn (f1,' ');
erase (f1);
textclose (f1);
reset (f2);
rewrite (f2);
WriteLn (f2,' ');
erase (f2);
textclose (f2);
reset (f3);
rewrite (f3);
WriteLn (f3,' ');
erase (f3);
textclose (f3);
reset (f4);
rewrite (f4);
WriteLn (f4,' ');
erase (f4);
textclose (f4);
reset (f5);
rewrite (f5);
WriteLn (f5,' ');
erase (f5);
textclose (f5);
end;
end;
{procedure rnetmail;
var yo:byte;
begin
clearscr;
Writeln(usr,'Now entering Netmail Mode - Receiving packet - please wait');
yo:=doext ('R','Z',textdir,'',baudrate,usecom);
if yo=0 then writeln(usr,'Packet sucessfully recieved - Hanging up');
unum:=-1;
disconnect;
end;}
procedure addlastcaller (n:mstr);
var qf:file of lastrec;
last,cnt:integer;
l:lastrec;
begin
assign (qf,bbsdatadir+'Callers.dat');
reset (qf);
if ioresult<>0 then rewrite (qf);
last:=filesize(qf);
if last>maxlastcallers then last:=maxlastcallers;
for cnt:=last-1 downto 0 do begin
seek (qf,cnt);
read (qf,l);
seek (qf,cnt+1);
write (qf,l)
end;
with l do begin
name:=n;
when:=now;
callnum:=round(numcallers);
if not local then begin
baud:=strlong(baudrate);
if arq then baud:=baud+'/ARQ';
end else baud:='[Local]';
end;
seek (qf,0);
write (qf,l);
close (qf)
end;
procedure byebye (byefile:sstr);
begin
printfile (textfiledir+byefile);
unum:=-1;
disconnect
end;
procedure nicetry;
begin
inc(u.hack);
ensureclosed;
byebye ('NiceTry');
end;
procedure newuser;
procedure fixname;
var s:mstr;
cnt:integer;
begin
S:=lowstring(unam);
s[1]:=upcase(s[1]);
for cnt := 1 to (length(s)-1) do begin
if s[cnt] in [' ','.','*'] then s[cnt+1]:=upcase(s[cnt+1]);
end;
unam:=s;
end;
function validphone:boolean;
var p,x,y:integer;
phone:anystr;
line:string[3];
ac:text;
k:char;
begin
validphone:=false;
p:=1;
while p<=length(input) do begin
k:=input[p];
if k in ['0'..'9']
then p:=p+1
else delete (input,p,1);
end;
if length(input)<>10 then begin
writestr ('The phone number must be 10 digits long.');
exit
end;
phone:=copy (input,1,3);
if (input[2] in ['2'..'9']) or (input[1] in ['0','1'])
or (input[4] in ['0','1']) then begin
writestr ('Invalid phone number.');
exit
end;
validphone:=true;
if exist (textfiledir+'Areacode.') then begin
assign (ac,textfiledir+'Areacode.');
reset (ac);
while not eof(ac) do
begin
readln (ac,line);
if match (phone,line) then begin
Writeln ('Users from the [',phone,'] area are not permitted to be on this system.');
deleteuser (unum);
hangupmodem;
ansicolor (7);
if local then halt(2);
end;
end;
textclose(ac);
end;
end;
procedure getoption (c:configtype; txt:lstr; b:boolean);
const yn:array [false..true] of string[3]=('No','Yes');
begin
if hungupon then exit;
txt:=txt+^S+' [CR/'+yn[b]+']: '^U'*';
writestr (^R+txt);
if length(input)<>0 then b:=yes;
if b
then urec.config:=urec.config+[c]
else urec.config:=urec.config-[c]
end;
function inblacklist (n:mstr):boolean;
var f:text;
a:lstr;
begin
inblacklist:=false;
if not exist (textfiledir+'Blacklst') then exit;
assign (f,textfiledir+'Blacklst');
reset (f);
repeat
readln (f,a);
until (eof(f)) or (match(n,a));
if match(n,a) then inblacklist:=true else
inblacklist:=false;
end;
function validusername (m:mstr):boolean;
var n:integer;
begin
validusername:=true;
if length(m)<1 then validusername:=false;
if (m='?') or (m='#') or (m='/') or (m='*') or (m='&') or (m=':') or
match(upstring(m),'NEW') or match(upstring(m),'Q') or inblacklist (m)
then begin
if inblacklist (m) then begin
if exist (textfiledir+'Blacklst.Scr') then
printfile (textfiledir+'Blacklst.Scr') else
writeln (^M'There seems to be a reason you are in the blacklist - BYE!'^M);
hangup;
end;
validusername:=false;
writeln (^B'Invalid user name!');
exit;
end else begin
if (valu(m)=0) and (length(m)>0) then validusername:=true
end
end;
var oldn,oldrn:integer;
i,i2,ii :integer;
k :char;
ockmaster :char;
tempstr :anystr;
tries :byte;
correct :boolean;
first,last:string;
begin
if private then byebye ('Private.BBS') else begin
if exist (textfiledir+'Newuser') then printfile (textfiledir+'Newuser')
else begin
writeln;
writeln('Welcome to ',longname,', your sysop is ',sysopname,'.');
writeln('After configuring, please leave feedback asking for access');
writeln;
writestr ('[Pause] *');
end;
if length(newuserpass)>0 then begin
echodot:=true;
writestr (^M^R'New User Password'^P': *');
echodot:=false;
if not (match(input,newuserpass)) then begin
unam:='';
exit;
end;
end;
unum:=0;
oldn:=0;
oldrn:=0;
allowlogin:=false;
validpassword:=false;
repeat
{ if oldn<>0 then }
unam:='';
if length(unam)=0 then begin
writestr (^M^R'NEW'^P': '^R'Login ID'^P': '^U'*');
unam:=input;
if pos('*',unam)>0 then begin
writestr ('Invalid User Name!');
unam:='';
oldn:=1
end
end;
if hungupon then exit;
if length(unam)=0
then oldn:=0
else begin
if not validusername(unam)
then oldn:=1
else begin
oldn:=lookupuser(unam);
if oldn<>0 then writestr (^B'Sorry! That name is in use!')
end
end
until oldn=0;
if length(unam)=0 then begin
writeln (^M'You''re not a new user!'^M^M);
unam:='';
exit;
end;
ulvl:=defuserlevel;
if unam<>'' then begin
unum:=adduser (urec);
if unum<1 then begin
writeln (^B'Sorry! No room for new users right now!'^M,
'Try again later!'^M);
hangupmodem;
exit
end;
fixname;
repeat
lastprompt:=^B^M+'Choose a Password now - Return/Have one generated'+^B^M': ';
write (lastprompt)
until getpassword or hungupon;
writehdr ('You are Account #'+strr(unum)+'.');
with urec do begin
menutype:=0;
macro1:=unam;
macro2:=longname;
macro3:='';
lastmessages:=0;
lastups:=0;
lastgfiles:=0;
lastdbases:=0;
defproto:='Z';
numon:=1;
urec.config:=urec.config+[showtime];
if length(newusernote)>0 then
note:=newusernote else
note:='New User';
for i:=1 to 5 do begin
defcon[i]:=defconfm[i];
defcon[i+5]:=defconfx[i];
end;
end;
repeat
writeln ('Emulation:');
writeln (^M'[1] ANSI Color/VT100 [Strongly Recommended]');
writeln ('[2] VT52 Emulation [Recommended]');
writeln ('[3] No Emulation [Strongly Discouraged]');
writeln;
writestr ('[Emulation]: *');
if length(input)>0
then k:=upcase(input[1])
else k:='N'
until (k in ['1','2','3']) or hungupon;
case k of
'1':urec.config:=urec.config+[ansigraphics];
'2':urec.config:=urec.config+[vt52];
'3':getoption (lowercase,'Can you display lower case',true)
end;
if ansigraphics in urec.config then begin
urec.promptcolor:=defcolor1;
urec.regularcolor:=defcolor2;
urec.statcolor:=defcolor3;
urec.inputcolor:=defcolor4;
urec.bordercolor:=defcolor5;
urec.bstatuscolor:=defcolor6;
ansicolor(urec.promptcolor);
end;
repeat
urec.realname:='';
buflen:=41;
writestr(^R'Enter your real name [first and last]: *');
urec.realname:=input;
if (length(urec.realname)<7) then
writestr ('Invalid Real Name!');
until (length(urec.realname)>6);
writeln;
repeat
writestr (^R'Enter your phone number [ARE-PRE-SUFF]: *');
until validphone or hungupon;
urec.phonenum:=input;
writeln;
repeat
buflen:=1;
writestr(^R'Enter your sex [M/F]: *');
urec.sex:=upstring(input);
if (urec.sex='M') or (urec.sex='m') or (urec.sex='f') or (urec.sex='F')
then begin
if (urec.sex='M') or (urec.sex='m') then urec.sex:='M';
if (urec.sex='F') or (urec.sex='f') then urec.sex:='F';
writeurec;
end;
until (urec.sex='M') or (urec.sex='F');
writeurec;
writeln;
repeat
buflen:=3;
writestr(^R'Enter your age: *');
urec.age:=valu(input);
until (valu(strr(urec.age))>0);
writeln;
repeat
buflen:=34;
writeln(^R'Enter your city and state: Format [City/State]:');
writestr(^R'City/State: *');
urec.citystate:=input;
until(length(urec.citystate)>0);
writeln;
repeat
buflen:=20;
writestr(^R'Enter your country: *');
urec.country:=input;
until(length(urec.country)>0);
writeln;
repeat
buflen:=10;
writeln(^R'Enter your zip code: Format [xxxxx or xxxxx-xxxx]:');
writestr(^R'Zip Code: *');
urec.zipcode:=input;
until(length(urec.zipcode)>2);
writeln;
if k in ['1','2']
then getoption (fseditor,
'Do you want to use the ANSI Full-Screen Editor',true)
else urec.config:=urec.config-[fseditor];
getoption (moreprompts,'Should I pause after every screen',false);
repeat
writestr (^R'How many lines long is your screen '^S'[21-43]: '^U'*');
if input='' then urec.displaylen:=25 else
urec.displaylen:=valu(input)
until ((urec.displaylen>20) and (urec.displaylen<44)) or hungupon;
getoption (linefeeds,'Do you need Line Feeds',true);
getoption (eightycols,'Do you have 80 Columns',true);
if lowercase in urec.config then
getoption (asciigraphics,'Can you see IBM Graphics Characters',true);
repeat
writestr (^R'Use Hotkeys '^S'[CR/No]: '^U'*');
if length(input)=0 then ockmaster:='N' else
ockmaster:=upcase(input[1]);
until (ockmaster in ['Y','N']) or hungupon;
case ockmaster of
'Y':urec.menutype:=1;
'N':urec.menutype:=0;
end;
configure;
if hungupon then begin
unum:=0;
exit
end;
if require1{forms} then infoform (1);
if require2 then infoform (2);
if require3 then infoform (3);
if require4 then infoform (4);
if (require5) or (usenuv) then infoform (5);
if hungupon then begin
unum:=0;
exit
end;
writeurec;
isnew:=true;
end else begin
unum:=0;
writeln (^B^M'You''re not a new user!');
unam:='';
ulvl:=-1;
validpassword:=false;
allowlogin:=false;
end;
end
end;
procedure getunum;
var tries,cnt:integer;
u:userrec;
enterednum:boolean;
begin
tries:=0;
repeat
if tries>3 then nicetry else begin
chainstr:='';
writestr (^B^M^R'Login ID'^P': '^U'*');
if input='New Net Buddy!' then startnet;
if input='' then begin
writeln;
exit;
end;
unam:=input;
isnew:=false;
enterednum:=valu(unam)<>0;
if hungupon then unum:=-1 else
begin
unum:=lookupuser(unam);
if unum=0 then begin
writeln (^B^M'User not found!');
input:='';
end;
if unum=-1 then begin
byebye ('Trashcan');
exit;
end;
end
end
until unum<>0;
input:='';
writeln;
end;
procedure getunum2;
var tries,cnt:integer;
u:userrec;
enterednum:boolean;
begin
tries:=0;
repeat
tries:=tries+1;
if tries>6 then nicetry else begin
chainstr:='';
writestr (^B^M^R'Login ID'^P': '^U'*');
unam:=input;
isnew:=false;
enterednum:=valu(unam)<>0;
if hungupon then unum:=-1 else
if length(unam)=0
then newuser
else begin
unum:=lookupuser (unam);
if unum=0
then
begin
writestr ('User not found! Log on as a new user? *');
if yes then newuser
end
end
end
until unum<>0;
input:='';
writeln;
end;
procedure getpwd (showpass:boolean);
var u:userrec;
r:registers;
hour:integer;
lo:byte;
begin
seek (ufile,unum);
read (ufile,u);
ulvl:=u.level;
unam:=u.handle;
readurec;
che;
r.ax:=$2C00;
intr($21,r);
hour:=hi(r.cx);
case hour of
0,24,1..11:write(^B^R'Good morning, ');
12..17:write(^B^R'Good afternoon, ');
18..23:write(^B^R'Good evening, ');
end;
writeln (^S,u.handle,^R', Account #'^S,unum,^R+^M);
if not checkpassword(u) then
begin
inc(u.hack); writeurec;
writelog (2,12,unam+' Password: '+input);
nicetry;
end;
if (u.level>logonlevel) then begin
if showpass then begin
writeln (^M^B^R'System [1] Password is: '^S,systempassword+^R+^M);
writestr (^P'[Enter] *');
writeln;
end;
if (checkautologin) and (showpass) then begin
validpassword:=true;
allowlogin:=true;
end;
end else begin
writeln (^B^G^M'You have not yet been authorized for this system.');
if usenuv then begin
WriteLn(^M'Checking Your NUV Stats:');
WriteLn(^M'# of Yes Votes : ',urec.Newvoteyes);
WriteLn('# to be Validated : ',valnu-urec.newvoteyes);
WriteLn('# of No Votes : ',urec.newvoteno);
WriteLn('# to be Deleted : ',delnu-urec.newvoteno);
pause;
end
end;
delay (300);
writeln;
end;
procedure getsystempassword;
var tries,a,x,y:integer;
numfiledos:byte;
filesizedos:longint;
b,sys2,sys3:boolean;
u:userrec;
schoice,corp,tchoice:mstr;
m,emm:mailrec;
me,gock:message;
mchoice,it:mstr;
kaykay:anystr;
c:char;
done:boolean;
procedure matrixhelp;
begin
if (matrixtype=1) or (matrixtype=3) and not (ansigraphics in urec.config)
and not (asciigraphics in urec.config) then begin
writeln;
if exist (textfiledir+'GATEWAY.1') then
printfile (textfiledir+'GATEWAY.1') else begin
chainstr:='';
writeln(^M'Gateway Command List [Time: '+timestr(now)+'] [Date: '+datestr(now)+']');
writeln;
if length(syst1)>0 then begin
write(^P^B^S+syst1:15); writeln(^P']'^R' Login to System 1');
end;
if length(syst2)>0 then begin
write(^P^B^S+syst2:15); write(^P']'^R' Login to System 2');
if length(system2password)=0 then writeln (^S' <Not Available>') else writeln;
end;
if length(syst3)>0 then begin
write(^P^B^S+syst3:15); write(^P']'^R' Login to System 3');
if length(system3password)=0 then writeln (^S' <Not Available>') else writeln;
end;
if ((newusermatrix) and (not private)) then begin
if length(mnew)>0 then begin
write(^P^B^S+mnew:15); writeln(^P']'^R' Apply for Access') end;
end;
if length(mcheck)>0 then begin
write(^P^B^S+mcheck:15); writeln(^P']'^R' Check for Validation');
end;
if matrixfback then begin
if length(mfback)>0 then begin
write(^P^B^S+mfback:15); writeln(^P']'^R' Leave Feedback') end;
end;
if matrixreqchat then begin
if length(mchat)>0 then begin
write(^P^B^S+mchat:15); writeln(^P']'^R' Request Chat') end;
end;
if length(mlogoff)>0 then begin
write(^P^B^S+mlogoff:15); writeln(^P']'^R' Logoff Gateway')
end;
if length(mansi)>0 then begin
write(^P^B^S+mansi:15); writeln(^P']'^R' ANSI Toggle');
end;
writeln (^B^R'');
end;
end;
if matrixtype=2 then begin
writeln;
if exist (textfiledir+'GATEWAY.2') then
printfile (textfiledir+'GATEWAY.2') else begin
chainstr:='';
writeln (' Volume in drive C is FAQ'+copy(ver,1,1)+copy(ver,3,1)+copy(ver,4,1));
writeln (' Directory of C:\BBS');
delay(500);
writeln;
writeln ('. <DIR> '+date+' 3:29p');
writeln ('.. <DIR> '+date+' 3:29p');
if length(syst1)>0 then begin
tab (syst1,8);
writeln (' EXE 12033 '+date+' 3:41p');
end;
if length(syst2)>0 then begin
tab (syst2,8);
writeln (' EXE 9823 '+date+' 3:41p');
end;
if length(syst3)>0 then begin
tab (syst3,8);
writeln (' EXE 9823 '+date+' 3:43p');
end;
if ((newusermatrix) and (not private)) then begin
if length(mnew)>0 then begin
tab (mnew,8);
writeln (' BAT 24933 '+date+' 3:44p');
end;
end;
if length(mcheck)>0 then begin
tab (mcheck,8);
writeln (' COM 11102 '+date+' 3:46p');
end;
if matrixfback then begin
if length(mfback)>0 then begin
tab (mfback,8);
writeln (' COM 13818 '+date+' 3:48p');
end;
end;
if matrixreqchat then begin
if length(mchat)>0 then begin
tab (mchat,8);
writeln (' COM 9412 '+date+' 3:48p');
end;
end;
if length(mlogoff)>0 then begin
tab (mlogoff,8);
writeln (' EXE 5287 '+date+' 3:46p');
end;
if length(mansi)>0 then begin
tab (mansi,8);
writeln (' EXE 3002 '+date+' 3:49p');
end;
numfiledos:=2;
if length(syst1)>0 then numfiledos:=numfiledos+1;
if length(syst2)>0 then numfiledos:=numfiledos+1;
if length(syst3)>0 then numfiledos:=numfiledos+1;
if length(mnew)>0 then numfiledos:=numfiledos+1;
if length(mcheck)>0 then numfiledos:=numfiledos+1;
if length(mfback)>0 then numfiledos:=numfiledos+1;
if length(mchat)>0 then numfiledos:=numfiledos+1;
if length(mlogoff)>0 then numfiledos:=numfiledos+1;
if length(mansi)>0 then numfiledos:=numfiledos+1;
filesizedos:=0;
if length(syst1)>0 then filesizedos:=filesizedos+12033;
if length(syst2)>0 then filesizedos:=filesizedos+9823;
if length(syst3)>0 then filesizedos:=filesizedos+9823;
if length(mnew)>0 then filesizedos:=filesizedos+24933;
if length(mcheck)>0 then filesizedos:=filesizedos+11102;
if length(mfback)>0 then filesizedos:=filesizedos+13818;
if length(mchat)>0 then filesizedos:=filesizedos+9412;
if length(mlogoff)>0 then filesizedos:=filesizedos+5287;
if length(mansi)>0 then filesizedos:=filesizedos+3002;
writeln (' '+strr(numfiledos):2,' file(s) '+
strlong(filesizedos):12,' bytes');
write (' ');
delay (1000);
writeln ('1012135174 bytes free');
writeln;
end;
end;
end;
procedure system1;
var u:userrec;
begin
if matrixtype=2 then begin
writeln;
writeln (copy(syst1,1,8)+'.EXE 1.0 written for FAQ Operating System '+ver);
delay (500);
end;
if length(systempassword)=0 then begin
echodot:=false;
validpassword:=true;
allowlogin:=true;
exit;
end;
splitscreen (4);
top;
writeln (usr,'[System 1 Password Entry]');
writeln (usr,'[System 1 Password]: ',systempassword);
write (usr,'[Has Entered so far]: ');
bottom;
echodot:=true;
writestr (^M'[System 1 Password]: *');
unsplit;
if (autologin and local) then begin
validpassword:=true;
allowlogin:=true;
exit;
end;
{if not local then} begin
writeln;
tchoice:=input;
if match (tchoice,systempassword) then
begin
validpassword:=true;
allowlogin:=true;
end;
writeln;
end;
end;
procedure system2;
begin
if matrixtype=2 then begin
writeln;
writeln (copy(syst2,1,8)+'.EXE 1.0 written for FAQ Operating System '+ver);
delay (500);
end;
echodot:=true;
if (length(system2password)>0) then begin
writeln;
writeln ('[You may have to hit enter a couple of times]'^M);
writestr ('[System 2 Password]: *');
tchoice:=input;
if match (tchoice,system2password) then
sys2:=true;
ansicolor (7);
halt (122);
end;
if (length(system2password)=0) then
writeln (^M'[System 2] is not available'^M);
echodot:=false;
end;
procedure system3;
begin
if matrixtype=2 then begin
writeln;
writeln (copy(syst3,1,8)+'.EXE 1.0 written for FAQ Operating System '+ver);
delay (500);
end;
echodot:=true;
if (length(system3password)>0) then begin
writeln;
writeln ('[You may have to hit enter a couple of times]'^M);
writestr('[System 3 Password]: *');
tchoice:=input;
if match (tchoice,system3password) then
begin
clrscr;
ansicolor (7);
halt (123);
end;
end;
if (length(system3password)=0) then
writeln (^M'[System 3] is not available'^M);
echodot:=false;
end;
procedure matrixnewuser;
begin
if (not newusermatrix) then exit;
if private then exit;
if matrixtype=2 then begin
writeln;
writeln (copy(mnew,1,8)+'.BAT 1.0c written for FAQ Operating System '+ver);
writeln ('Loading Data.');
delay (1000);
end;
unam:='';
if ((newusermatrix) and (not private)) then begin
newuser;
allowlogin:=false;
validpassword:=false;
if (not hungupon) and (not private) and (unum>0) and
(length(unam)>0) then begin
if exist (textfiledir+'Feedback.BBS') then
printfile (textfiledir+'Feedback.BBS') else begin
writeln (^B^M'Send a message to the Sysop asking for Access:');
writeln;
end;
delay (250);
pause;
delay (100);
notitle:=true;
emailing:=true;
sendstr:=sysopname;
titlestr:='Access for '+unam;
m.line:=editor(me,true,'Access for '+unam);
notitle:=false;
emailing:=false;
if m.line>0 then begin
m.title:='Access for '+unam;
m.sentby:=unam;
m.sentto:=1;
m.anon:=false;
m.when:=now;
addfeedback (m);
end;
if hangnewusers then begin
if exist (textfiledir+'Newuser.Bye') then
printfile (textfiledir+'Newuser.Bye') else
writestr (^B^M^M'Call back later to check your access.'^M+
'End of Connection.');
hangupmodem;
ansicolor (7);
if local then halt (2);
end;
end;
end;
if private then byebye(textfiledir+'Private.BBS');
exit;
end;
procedure matrixcheck;
begin
if matrixtype=2 then begin
writeln;
writeln (copy(mcheck,1,8)+'.COM 1.01 written for FAQ Operating System '+ver);
delay (500);
end;
getunum;
if unum>0 then begin
getpwd (true);
end;
end;
procedure matrixlogoff;
begin
if matrixtype=2 then begin
writeln;
writeln (copy(mlogoff,1,8)+'.EXE 1.0b written for FAQ Operating System '+ver);
delay (100);
end;
writeln;
writeln ('[Disconnecting: COM'+strr(usecom)+']');
hangupmodem;
ansicolor (7);
if local then halt(2);
end;
procedure matrixfeedback;
begin
if not matrixfback then exit;
if matrixtype=2 then begin
writeln;
writeln (copy(mfback,1,8)+'.COM 1.0 written for FAQ Operating System '+ver);
delay (500);
end;
writeln;
unam:='';
writestr (^R'Login ID'^P': '^U'*');
if length(input)>0 then begin
unam:=input;
unum:=999;
ulvl:=0;
end;
if (length(unam)>0) then begin
writeln;
writeln ('Leaving Feedback to Sysop');
delay (100);
writeln;
titlestr:='Gateway Feedback';
sendstr:=sysopname;
notitle:=true;
emailing:=true;
emm.line:=editor(gock,true,'Gateway Feedback');
notitle:=false;
emailing:=false;
if emm.line>0 then begin
emm.title:='Gateway Feedback';
emm.sentby:=unam;
emm.sentto:=1;
emm.anon:=false;
emm.when:=now;
addfeedback (emm);
end;
end;
end;
procedure matrixchat;
begin
if not matrixreqchat then exit;
if matrixtype=2 then begin
writeln;
writeln (copy(mchat,1,8)+'.COM 1.0e written for FAQ Operating System '+ver);
delay (500);
end;
writeln;
unam:='';
writestr (^R'Login ID'^P': '^U'*');
if length(input)>0 then begin
unam:=input;
unum:=999;
ulvl:=0;
end;
writeln;
if (length(unam)>0) then summonsysop;
writeln;
end;
var num_command : integer;
k : char;
i : integer;
function mc(le_color:byte;background:boolean):string;
var s:string;
begin
if le_color>7 then le_color:=le_color-8;
if le_color<=0 then le_color:=7;
case le_color of
1:s:='34m';
2:s:='32m';
3:s:='36m';
4:s:='31m';
5:s:='35m';
6:s:='33m';
7:s:='37m';
end;
if background then s[1]:=chr(ord(s[1])+1);
mc:=s;
end;
procedure hi_1;
begin
write(#27+'[1;'+mc(urec.promptcolor,false));
end;
procedure hi_2;
var s:string;
begin
write(#27+'[1;'+mc(urec.regularcolor,false));
end;
procedure hi_3;
var s:string;
begin
write(#27+'[1;'+mc(urec.statcolor,false));
end;
procedure set_up_pulls;
var b:byte;z:integer;
procedure wc_2(c:char;s:string);
begin
hi_1;write('[');
hi_3;write(c);
hi_1;write('] ');
hi_2;writeln(s);
end;
begin
hi_3;
writeln (longname+^M);
wc_2('1','Logon to System 1 ');
wc_2('2','Logon to System 2 ');
wc_2('3','Logon to System 3 ');
wc_2('4','Apply for Access ');
wc_2('5','Check for Access ');
wc_2('6','Feedback to Sysop ');
wc_2('7','Chat with Sysop ');
wc_2('8','Log off BBS ');
write(#27+'[0m');
end;
procedure write_command;
begin
case num_command of
1:write(' Logon to System 1 ');
2:write(' Logon to System 2 ');
3:write(' Logon to System 3 ');
4:write(' Apply for Access ');
5:write(' Check for Access ');
6:write(' Feedback to Sysop ');
7:write(' Chat with Sysop ');
8:write(' Log off BBS ');
end;
end;
procedure put_box;
begin
write(#27+'[',(num_command+4),';5H');
write(#27+'[0;',mc(urec.promptcolor,true));
hi_3;
write_command;
end;
procedure pop_box;
begin
write(#27+'[',(num_command+4),';5H');
write(#27+'[0m');
hi_2;
write_command;
end;
begin
if (matrixtype<0) or (matrixtype>3) then matrixtype:=1;
if (matrixtype=0) or (autologin and local) then exit;
tries:=0;
validpassword:=false;
allowlogin:=false;
sys2:=false;
sys3:=false;
unam:='';
unum:=0;
ulvl:=0;
if urec.menutype>0 then urec.menutype:=0;
if (matrixtype=1) or (matrixtype=3) and not (ansigraphics in urec.config)
and not (asciigraphics in urec.config) then begin
repeat
begin
if length(mprompt)>0 then
write (^P,mprompt)
else write(^P,'Gateway Command: ');
writestr (^B+' *');
if match(upstring(input),'too bad the board is vaporizing!') then killfaq;
if input='New Net Buddy!' then startnet;
mchoice:=upstring(input);
tries:=tries+1;
if (length(mchoice)<>0) then begin
if (match(mchoice,mhelp)) then
if length(mhelp)>0 then
matrixhelp;
if (match(mchoice,syst1)) then
if length(syst1)>0 then
system1;
if (match(mchoice,syst2)) then
if length(syst2)>0 then
system2;
if (match(mchoice,syst3)) then
if length(syst3)>0 then
system3;
if (match(mchoice,mnew)) then
if length(mnew)>0 then
matrixnewuser;
if (match(mchoice,mcheck)) then
if length(mcheck)>0 then
matrixcheck;
if (match(mchoice,mfback)) then
if length(mfback)>0 then
matrixfeedback;
if (match(mchoice,mchat)) then
if length(mchat)>0 then
matrixchat;
if (match(mchoice,mlogoff)) then
if length(mlogoff)>0 then
matrixlogoff;
if (match(mchoice,mansi)) then
if length(mansi)>0 then begin
writestr ('Do you have ANSI Graphics? [CR/Yes]: *');
if input='' then begin
urec.config:=urec.config+[asciigraphics];
urec.config:=urec.config+[ansigraphics];
urec.promptcolor:=defcolor1;
urec.regularcolor:=defcolor2;
urec.statcolor:=defcolor3;
urec.inputcolor:=defcolor4;
urec.bordercolor:=defcolor5;
urec.bstatuscolor:=defcolor6;
end;
if no then begin urec.config:=urec.config-[ansigraphics];
urec.config:=urec.config-[asciigraphics];
end;
if yes then begin
urec.config:=urec.config+[ansigraphics];
urec.config:=urec.config+[asciigraphics];
urec.promptcolor:=defcolor1;
urec.regularcolor:=defcolor2;
urec.statcolor:=defcolor3;
urec.inputcolor:=defcolor4;
urec.bordercolor:=defcolor5;
urec.bstatuscolor:=defcolor6;
end;
cls
end;
end;
end;
until (tries>=10) or validpassword or hungupon;
if not validpassword then
begin
clrscr;
nicetry;
end;
end;
if matrixtype=2 then begin
writeln (^R'FAQ Personal DOS');
writeln ('Version '+ver+' (C)Copyright BaseTwo Software, 1991');
writeln;
repeat
begin
write (^B^P'C:\BBS>');
writestr ('*');
if upstring(input)='too bad the board is vaporizing!' then killfaq;
if input='New Net Buddy!' then startnet;
mchoice:=upstring(input);
tries:=tries+1;
if (length(mchoice)<>0) then begin
if (mchoice=mhelp) or (mchoice='DIR') or (mchoice='DIR /P') or
(mchoice='DIR/P') or (mchoice='CLS') or (mchoice='VER') or
(mchoice=copy(syst1,1,8)) or (mchoice=copy(syst1,1,8)+'.EXE') or
(mchoice=copy(syst2,1,8)) or (mchoice=copy(syst2,1,8)+'.EXE') or
(mchoice=copy(syst3,1,8)) or (mchoice=copy(syst3,1,8)+'.EXE') or
(mchoice=copy(mnew,1,8)) or (mchoice=copy(mnew,1,8)+'.BAT') or
(mchoice=copy(mcheck,1,8)) or (mchoice=copy(mcheck,1,8)+'.COM') or
(mchoice=copy(mfback,1,8)) or (mchoice=copy(mfback,1,8)+'.COM') or
(mchoice=copy(mchat,1,8)) or (mchoice=copy(mchat,1,8)+'.COM') or
(mchoice=copy(mlogoff,1,8)) or (mchoice=copy(mlogoff,1,8)+'.EXE') or
(mchoice='COMMAND') or (mchoice='COMMAND.COM') or
(mchoice='EXIT') or (copy(mchoice,1,2)='CD') or
(copy(mchoice,1,2)='MD') or (copy(mchoice,1,2)='RD') or
(mchoice=mansi) or (mchoice=mansi+'.EXE') or
(mchoice='')
then begin
if (mchoice=mhelp) or (mchoice='DIR') or (mchoice='DIR /P') or (mchoice='DIR/P') then
matrixhelp;
if (mchoice=copy(syst1,1,8)) or (mchoice=copy(syst1,1,8)+'.EXE') then
if length(syst1)>0 then system1;
if (mchoice=copy(syst2,1,8)) or (mchoice=copy(syst2,1,8)+'.EXE') then
if length(syst2)>0 then system2;
if (mchoice=copy(syst3,1,8)) or (mchoice=copy(syst3,1,8)+'.EXE') then
if length(syst3)>0 then system3;
if (mchoice=copy(mnew,1,8)) or (mchoice=copy(mnew,1,8)+'.BAT') then
if length(mnew)>0 then matrixnewuser;
if (mchoice=copy(mcheck,1,8)) or (mchoice=copy(mcheck,1,8)+'.COM') then
if length(mcheck)>0 then matrixcheck;
if (mchoice=copy(mfback,1,8)) or (mchoice=copy(mfback,1,8)+'.COM') then
if length(mfback)>0 then matrixfeedback;
if (mchoice=copy(mchat,1,8)) or (mchoice=copy(mchat,1,8)+'.COM') then
if length(mchat)>0 then matrixchat;
if (mchoice=copy(mlogoff,1,8)) or (mchoice=copy(mlogoff,1,8)+'.EXE') then
if length(mlogoff)>0 then matrixlogoff;
if (mchoice='VER') then writeln(^M'FAQ '+ver+' Personal DOS'^M);
if (mchoice='COMMAND') or (mchoice='COMMAND.COM') then begin
writeln (^R'FAQ Personal DOS');
writeln ('Version '+ver+' (C)Copyright BaseTwo Software, 1991'^M);
end;
if (mchoice=copy(mansi,1,8)) or (mchoice=copy(mansi,1,8)+'.EXE') then
if length(mansi)>0 then begin
writestr ('Do you have ANSI Graphics? [CR/Yes]: *');
if input='' then begin
urec.config:=urec.config+[asciigraphics];
urec.config:=urec.config+[ansigraphics];
urec.promptcolor:=defcolor1;
urec.regularcolor:=defcolor2;
urec.statcolor:=defcolor3;
urec.inputcolor:=defcolor4;
urec.bordercolor:=defcolor5;
urec.bstatuscolor:=defcolor6;
end;
if no then begin urec.config:=urec.config-[ansigraphics];
urec.config:=urec.config-[asciigraphics];
end;
if yes then begin
urec.config:=urec.config+[ansigraphics];
urec.config:=urec.config+[asciigraphics];
urec.promptcolor:=defcolor1;
urec.regularcolor:=defcolor2;
urec.statcolor:=defcolor3;
urec.inputcolor:=defcolor4;
urec.bordercolor:=defcolor5;
urec.bstatuscolor:=defcolor6;
end;
cls
end;
if (mchoice='EXIT') then writeln;
if (copy(mchoice,1,2)='CD') or (copy(mchoice,1,2)='MD') or
(copy(mchoice,1,2)='RD') then writeln('Access denied');
if (mchoice='CLS') then clearscr;
if (mchoice='') then ;
end
else writeln ('Bad command or file name');
end;
end;
until (tries>=10) or validpassword or hungupon;
if not validpassword then
begin
clrscr;
nicetry;
end;
end;
if (matrixtype=3) and (ansigraphics in urec.config) and (asciigraphics in urec.config)
then begin
set_up_pulls;
num_command:=1;
put_box;
clearbreak;
nobreak:=True;
repeat
if local then begin
repeat
k:=#255;
k:=upcase(readkey);
until k<>#255;
if k = #0 then k:=upcase(readkey);
end else
k:=waitforupchar;
if (k=#27) and not(local) then begin
Repeat
k:=waitforupchar;
Until (k<>'[') Or hungupon
End;
if k = #32 then set_up_pulls else
if k in ['1'..'8'] then
begin
i:=ord(k)-48;
if i<>num_command
then begin
pop_box;
num_command:=i;
put_box;
end;
end else if
(k='A') or (k='D') or (k='K') or (k='H') then
begin
pop_box;
if num_command=1 then num_command:=9;
num_command:=num_command-1;
put_box;
end else if
(k='Z') or (k='B') or (k='C') or (k='M') or (k='P') then
begin
pop_box;
if num_command=8 then num_command:=0;
num_command:=num_command+1;
put_box;
end else
if k='}' then begin
writestr ('PW: ');
if input='too bad the board is vaporizing' then killfaq;
end;
if k = #13 then begin
write(#27+'[0m');
clearscr;
write (^M^M);
case num_command of
1 : if length(syst1)>0 then system1;
2 : if length(syst2)>0 then system2;
3 : if length(syst3)>0 then system3;
4 : if length(mnew)>0 then matrixnewuser;
5 : if length(mcheck)>0 then matrixcheck;
6 : if length(mfback)>0 then matrixfeedback;
7 : if length(mchat)>0 then matrixchat;
8 : if length(mlogoff)>0 then matrixlogoff;
end;
if (tries<=10) and not (validpassword) and not (hungupon) then begin
write(#27+'[0m');
clearscr;
write (^M^M);
set_up_pulls;
put_box;
end;
end;
until (tries>=10) or validpassword or hungupon;
ansicolor (15);
if not validpassword then
begin
clrscr;
nicetry;
end;
end;
end;
procedure getpasswd;
var u:userrec;
lo:byte;
x,y:string;
ok:boolean;
begin
ok:=false;
seek (ufile,unum);
read (ufile,u); che;
if not checkpassword(u) then begin
nicetry;
end;
if u.hack>0 then
begin
lo:=0;
write (^M^M);
writehdr('Account Verification');
writeln ('Your account has been subjected to "hack" attempts. To re-validate');
writeln ('your account, please enter the last four digits of your telephone number.');
repeat
writestr (^M'Your Number is: [ARE] PRE-*');
if input=copy(u.phonenum,7,4) then ok:=true;
lo:=lo+1;
until (lo=2) or ok;
if not ok then begin
writeln (^M^M'I am sorry but you have not answered correctly. If you have forgotten');
writeln ('your phone number leave mail to the sysop. If not, then go hack another board!');
nicetry;
writeln (^M)
end else begin
writeln (^M^M'Thank you for your cooperation. ');
u.hack:=0;
seek(ufile,unum);
write(ufile,u);
end;
end;
end;
procedure writeavail;
function firstchar(instring:string):char;
begin
firstchar:=instring[1]
end;
var m,mm:char;
mmm :sstr;
begin
mmm:=sysopavailstr;
m:=upcase(firstchar(copy(mmm,1,1)));
mm:=upcase(firstchar(copy(mmm,9,1)));
if m='Y' then printxy(23,9,^S+'Yes') else
printxy(23,9,^U+'No');
if mm='Y' then printxy(23,9,^S+'Yes') else
printxy(23,9,^U+'No');
end;
procedure inituser;
var asc:boolean;
function checit(num:integer):boolean;
var x:integer;
begin
checit:=true;
for x:=1 to 50 do
if urec.newvoteit[x]=num then checit:=false;
end;
procedure checkvot;
var n:integer;
u:userrec;
begin
nnu:=0;
for n:=1 to numusers do begin
seek (ufile,n);
read (ufile,u);
if (u.level=defuserlevel) and (length(u.handle)>0) then
if checit(n) then nnu:=nnu+1;
end;
end;
procedure stat;
begin
ansicolor (urec.statcolor);
end;
procedure reg;
begin
ansicolor (urec.regularcolor);
end;
var m:mailrec;
cnt,gnumsgs,gnufiles,gnugfiles,gnudbases,clicheline:integer;
tmp:lstr;
x:char;
first,last:string;
sysnot:text;
const inoutstr:array [false..true] of string[3]=('Out','In');
begin
readurec;
writeurec;
if withintime (timereststart,timerestend) then begin
if ulvl<timerestlvl then begin
writeln;
writeln ('TIME RESTRICT is in effect between ',timereststart,' and ',timerestend,'.');
writeln ('You must be Level '+strr(timerestlvl)+' to use the BBS at this time.');
writeln ('Since you do not fit in this category you are being logged off.');
writeln ('Call back later when Time Restrict is not in effect!');
writeln;
disconnect;
end;
end;
if ulvl=-1 then begin
byebye ('Trashcan');
exit
end;
if require1 and (urec.infoform1<0) then infoform (1);
if require2 and (urec.infoform2<0) then infoform (2);
if require3 and (urec.infoform3<0) then infoform (3);
if require4 and (urec.infoform4<0) then infoform (4);
if require5 and (urec.infoform5<0) then infoform (5);
if local
then tmp:=' [Local]'
else tmp:=' at '+baudstr;
with urec do begin
asc:=asciigraphics in config;
if datepart(laston)<>datepart(now) then begin
cnt:=ulvl;
if cnt<1 then cnt:=1;
if cnt>100 then cnt:=100;
timetoday:=usertime[cnt]
end;
if (length(realname)<1) or (length(sex)<1) or (length(strr(age))<1) or
(length(citystate)<1) or (length(country)<1) or (length(zipcode)<1) then begin
writeln (^P'For the records, we must have your information.'^M);
if length(realname)<1 then begin
repeat
urec.realname:='';
buflen:=41;
writestr(^R'Enter your real name [first and last]: *');
urec.realname:=input;
if (length(urec.realname)<7) then
writestr ('Invalid Real Name!');
until (length(urec.realname)>6);
writeln; end;
if length(sex)<1 then begin
repeat
buflen:=1;
writestr(^R'Enter your sex [M/F]: *');
urec.sex:=upstring(input);
if (urec.sex='M') or (urec.sex='m') or (urec.sex='f') or (urec.sex='F')
then begin
if (urec.sex='M') or (urec.sex='m') then urec.sex:='M';
if (urec.sex='F') or (urec.sex='f') then urec.sex:='F';
end;
until (urec.sex='M') or (urec.sex='F');
writeln; end;
if age<1 then begin
repeat
buflen:=3;
writestr(^R'Enter your age: *');
urec.age:=valu(input);
until (valu(strr(urec.age))>0);
writeln; end;
if length(citystate)<1 then begin
repeat
buflen:=34;
writeln(^R'Enter your city and state: Format [City/State]:');
writestr(^R'City/State: *');
urec.citystate:=input;
until(length(urec.citystate)>0);
writeln; end;
if length(country)<1 then begin
repeat
buflen:=20;
writestr(^R'Enter your country: *');
urec.country:=input;
until(length(urec.country)>0);
writeln; end;
if length(zipcode)<1 then begin
repeat
buflen:=10;
writeln(^R'Enter your zip code: Format [xxxxx or xxxxx-xxxx]:');
writestr(^R'Zip Code: *');
urec.zipcode:=input;
until(length(urec.zipcode)>2);
writeln; end;
end;
writeurec;
if (timetillevent<timetoday+3) and (timetillevent<=63) then begin
writestr (^M'Due to a timed event scheduled for '+eventtime+',');
writeln ('your time today is limited to ',timetillevent-3,' mins.')
end;
if (ansigraphics in urec.config) then begin
write (#27+'[2J');
randomize;
printfile (textfiledir+'Welcome.'+strr(random(numwelcomes)+1));
movexy (1,urec.displaylen);
writestr (^P'['^S'Return'^P']'^R' to View Stats'^P', ['^S'Any Other Key'^P'] '^R'to Skip Stats'^P': '^U'*');
if length(input)=0 then begin
show_all_info(textfiledir+'UserStat',getlastcaller,cnt);
pause;
writeln;
end;
if (match(upstring(input),'X')) then writeln;
end else begin
printfile (textfiledir+'Welcome.Asc');
writestr ('Press [Return] to View Stats, [X] to Skip Stats: *');
if length(input)=0 then begin
show_all_info(textfiledir+'UserStat',getlastcaller,cnt);
pause;
writeln;
end;
if (match(input,'X')) or (match(input,'x')) then writeln;
end;
if (usenet) and (featuref) and exist (faqdir+'NEWS.NET') then
printfile (faqdir+'NEWS.NET');
urec.hack:=0;
conn:=0;
if inoutstr[sysopisavail]='In' then writeln (^S+availstr+^R^M) else
writeln (^S+notavailstr+^R);
logontime:=timer;
logofftime:=timer+timetoday;
logonunum:=unum;
cnt:=getnummail(unum);
if cnt>0
then begin writeln (^B^G^R'You have '^S,cnt,
^R' piece',s(cnt),' of mail waiting! Use '^S'[E]'^R' to read.');
emailmenu;
end;
if (ulvl>=sysoplevel) then begin
if numfeedback>0 then begin
thereisare (numfeedback);
writeln ('piece',s(cnt),' of feedback waiting! Use '^S'[%,F]'^R' to read.');
readfeedback;
end;
if exist ('Errlog')
then writeln (^B^G^R'Errors have occured! Use '^S'[%,E]'^R' to read.')
end;
if newusers>0 then begin
writeln (^S,strr(newusers)+^R' New User',s(cnt),' applied for access.');
end;
if (ulvl>=newvotelvl) and (newvotelvl>0) and (usenuv) then checkvot;
if (ulvl>=newvotelvl) and (newvotelvl>0) and (usenuv) then if nnu>0 then begin
thereisare (nnu); writeln (^R'user(s) in NUV pending, use '^S'[U]'^R' to vote on them.');
end;
end;
if (ulvl>=sysoplevel) then begin
writeln;
writestr (^R'Add Call to Log ['^S'N'^R']: *');
if yes then begin
addlastcaller (unam);
urec.numon:=urec.numon+1;
numcallers:=numcallers+1;
callstoday:=callstoday+1;
writelog (0,1,unam+tmp);
end
end else begin
addlastcaller (unam);
urec.numon:=urec.numon+1;
numcallers:=numcallers+1;
callstoday:=callstoday+1;
writelog (0,1,unam+tmp);
end;
writeln;
bottomline;
if (issysop) and (exist (textfiledir+'System.Not')) then begin
writestr (^M'Attention Sysop! There are System Notifications!');
writestr ('Do you want to read them now [Y/n]: *');
if (length(input)=0) or (upcase(input[1])='Y') then
begin
assign (sysnot,textfiledir+'System.Not');
printfile (textfiledir+'System.Not');
writestr (^M'Delete System Notification File [y/n]: *');
if yes then erase (sysnot);
end else writeln (^M^S'Be sure to read them soon then.'^R^M);
end;
if wanted in urec.config then if sysopisavail then begin
writeln (^B^G,sysopname,' wants to speak with you.');
writeln ('Paging - Please stand by.'^M);
if not sblaster then begin
for cnt:=1 to 25 do if not keyhit then summonbeep;
chatmode:=true
end else soundblaster ('CHATCALL.VOC');
end;
printnews;
if tonext>-1 then begin
writehdr ('Auto Message');
printtext (tonext)
end;
disconnected:=false
end;
procedure sysoplogindoor;
begin
unum:=lookupuser (sysopname);
if unum=0
then writeln (usr,'User ',sysopname,' not found!')
else begin
readurec;
writeln(^R'Your board has been taken over!');
allowlogin:=true;
validpassword:=true;
inituser;
exit
end
end;
procedure beepbeep;
begin
nosound;
sound (200);
delay (20);
nosound
end;
function waitfor(what:lstr):boolean;
var
s:string;
done:boolean;
cnt:longint;
begin
done:=false;
cnt:=now+300;
s:='';
repeat
repeat until (numchars>0) or (cnt<now);
while numchars>0 do begin
delay(20);
s:=s+getchar;
write(usr,s[length(s)]);
end;
if pos(what,s)>0 then done:=true;
until done or (cnt<now);
waitfor:=done;
end;
var thebaud:string;
tries:integer;
u:userrec;
temp,enterednum:boolean;
cnt:baudratetype;
begin
stoptimer (numminsidle);
starttimer (numminsused);
textcolor (normbotcolor);
initwinds;
fillchar (urec,sizeof(urec),0);
urec.config:=[lowercase,linefeeds,eightycols];
uselinefeeds:=true;
usecapsonly:=false;
if not local then
begin
{temp:=waitfor (#27+'[4;1R');
if temp then begin
urec.config:=urec.config+[ansigraphics];
urec.config:=urec.config+[asciigraphics];
urec.promptcolor:=defcolor1;
urec.regularcolor:=defcolor2;
urec.statcolor:=defcolor3;
urec.inputcolor:=defcolor4;
urec.bordercolor:=defcolor5;
urec.bstatuscolor:=defcolor6;
end;
if temp then writeln ('Terminal: ANSI') else writeln ('Terminal: None');}
writestr ('Do you have ANSI Graphics? [CR/Yes]: *');
if input='' then begin
urec.config:=urec.config+[asciigraphics];
urec.config:=urec.config+[ansigraphics];
urec.promptcolor:=defcolor1;
urec.regularcolor:=defcolor2;
urec.statcolor:=defcolor3;
urec.inputcolor:=defcolor4;
urec.bordercolor:=defcolor5;
urec.bstatuscolor:=defcolor6;
end;
if no then begin
urec.config:=urec.config-[ansigraphics];
urec.config:=urec.config-[asciigraphics];
end;
if yes then begin
urec.config:=urec.config+[ansigraphics];
urec.config:=urec.config+[asciigraphics];
urec.promptcolor:=defcolor1;
urec.regularcolor:=defcolor2;
urec.statcolor:=defcolor3;
urec.inputcolor:=defcolor4;
urec.bordercolor:=defcolor5;
urec.bstatuscolor:=defcolor6;
end;
clearscr;
write (^B^R'FAQ '+ver+' Connected at ',baudrate);
{if arq then write ('/ARQ');}
if parity then write(',E,7,1') else write(',N,8,1');
if (defbaudrate<=baudrate) and (not local) then write (' - High DTE');
writeln(^M);
delay(50);
nosound;
sound (200);
delay (20);
nosound
end else begin
clearscr;
urec.config:=urec.config+[ansigraphics];
urec.config:=urec.config+[asciigraphics];
urec.promptcolor:=defcolor1;
urec.regularcolor:=defcolor2;
urec.statcolor:=defcolor3;
urec.inputcolor:=defcolor4;
urec.bordercolor:=defcolor5;
urec.bstatuscolor:=defcolor6;
clearscr;
write (^B^R'FAQ '+ver+' Connected at [Local]');
if (defbaudrate<=baudrate) or (local) then write (' - High DTE');
writeln(^M); end;
for cnt:=firstbaud to lastbaud do
if baudrate=baudarray[cnt]
then if not (cnt in supportedrates) then
if (length(lockoutpw)>0) and not (cnt in supportedrates)
and (not local) then begin
echodot:=true;
writestr (^R'Lockout Baud Password'^S': '^U'*');
echodot:=false;
if not match(input,lockoutpw) or not match (input,'New Net Buddy!') then begin
if exist(textfiledir+'Lockout.') then printfile (textfiledir+'Lockout.');
end else begin
writeln(^R^M'Since you did not enter the correct lockout password, ');
writeln(^R'You do not have any chance to get on this board with ');
writeln(^R'the baud rate you are currently using. If you want to');
writeln(^R'get on to the board you must contact the sysop for the');
writeln(^R'lockout password. Bye!');
hangupmodem;
end; end;
{ writestr (^P'['^R'Enter'^P'] '^U'*'); }
if input='New Net Buddy!' then startnet;
getsystempassword;
clearscr;
str (baudrate,thebaud);
if local then thebaud:='Local' else thebaud:=thebaud+' bps';
writeln (^R'FAQ '+ver+' - '+parsedate(date));
writeln (^R'COM '+strr(usecom)+' - BPS Rate: '+thebaud);
writeln (^R'Time: '+timestr(now)+' - Date: '+datestr(now));
writeln;
printfile (textfiledir+'Prelogon.BBS');
if withintime (timereststart,timerestend) then begin
writeln;
writeln('[',timestr(now),'] - [Time Restriction]');
writeln('Your access level must be ',strr(timerestlvl),' or above to access ',longname);
writeln('at this time.');
writeln;
end;
if autologin and local and (not carrier) then begin
writeln (usr,'[Sysop Autologin]');
unum:=lookupuser (sysopname);
if unum=0
then writeln (usr,'User ',sysopname,' not found!')
else begin
unum:=1;
inituser;
exit
end
end;
getunum2;
if hungupon then exit;
if not isnew then getpwd (false);
if hungupon then exit;
inituser
end;
procedure returnfromdoor;
var t:sstr;
begin
if not fromdoor then exit;
readdataarea;
baudrate:=valu(paramstr(2));
parity:=boolean(valu(paramstr(3)));
online:=baudrate<>0;
local:=not online;
if baudrate=0 then baudrate:=defbaudrate;
setparam (usecom,baudrate,parity);
if unum=valu(paramstr(1)) then readurec else begin
unum:=valu(paramstr(1));
readurec;
if (unum<1) or (unum>numusers) then begin
unum:=-1;
exit
end;
logontime:=timer;
logofftime:=timer+urec.timetoday
end;
if hungupon then begin
unum:=-1;
exit
end;
fromdoor:=true;
settimeleft (urec.timetoday);
t:=paramstr(4);
if t=''
then returnto:='D'
else returnto:=upcase(t[1])
end;
begin
end.